home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / vbjigsaw.zip / JIGSAW.TXT < prev    next >
Text File  |  1991-05-30  |  22KB  |  676 lines
  1. DefInt A-Z
  2.  
  3. Declare Function BitBlt Lib "Gdi" (ByVal destHdc, ByVal X, ByVal Y, ByVal w, ByVal h, ByVal srcHdc, ByVal srcX, ByVal srcY, ByVal Rop As Long)
  4. Declare Function CreateRectRgn Lib "Gdi" (ByVal X1, ByVal Y1, ByVal X2, ByVal Y2)
  5. Declare Function SetRectRgn Lib "Gdi" (ByVal hRgn, ByVal X1, ByVal Y1, ByVal X2, ByVal Y2)
  6. Declare Function SelectClipRgn Lib "Gdi" (ByVal Hdc, ByVal hRgn)
  7. Declare Function CombineRgn Lib "Gdi" (ByVal hDestRgn, ByVal hSrcRgn1, ByVal hSrcRgn2, ByVal nCombineMode)
  8.  
  9. Const SRCCOPY = &HCC0020
  10. Const SRCAND = &H8800C6
  11. Const SRCINVERT = &H660046
  12. Const NOTSRCCOPY = &H330008
  13. Const SRCINVERTANDDEST = &H220B24
  14.  
  15. Const RGN_AND = 1
  16. Const RGN_DIFF = 4
  17. Const NULLREGION = 1
  18.  
  19. Const TRUE = -1
  20. Const FALSE = 0
  21. Const MODAL = 1
  22.  
  23. Const MID_OPEN = 0
  24. Const MID_CLIPBOARD = 1
  25. Const MID_EXIT = 3
  26.  
  27. Const MID_SCRAMMBLE = 0
  28. Const MID_SOLVE = 1
  29. Const MID_ANIMATE = 2
  30. Const MID_PIECES_TO_FOREGROUND = 3
  31. Const MID_SHOW_SCRAMMBLING = 5
  32. Const MID_SCRAMMBLE_ON_OPEN = 6
  33.  
  34. Const MID_CIRCLES_AND_OTHERS = 1
  35. Const MID_ELIPSES_AND_OTHERS = 2
  36. Const MID_ANGELS_AND_STARS = 3
  37. Const MID_CIRCLES_IN_SQUARES = 4
  38.  
  39. Dim TotalPieces  As Integer
  40. Dim PuzzleSize   As Integer
  41. Dim PieceHeight  As Integer
  42. Dim PieceWidth   As Integer
  43. Dim MovingPiece  As Integer
  44. Dim LastMouseX   As Integer
  45. Dim LastMouseY   As Integer
  46. Dim MaskNeeded   As Integer
  47. Dim Solved       As Integer
  48.  
  49. Dim Region1 As Integer
  50. Dim Region2 As Integer
  51. Dim Region3 As Integer
  52. Dim Region4 As Integer
  53.  
  54. Dim Piece As PIECEINFO
  55. Dim Pieces() As PIECEINFO
  56. Dim Priority() As Integer
  57.  
  58.  
  59. Sub Form_Load ()
  60.  
  61.     Region1 = CreateRectRgn(0, 0, 0, 0)
  62.     Region2 = CreateRectRgn(0, 0, 0, 0)
  63.     Region3 = CreateRectRgn(0, 0, 0, 0)
  64.     Region4 = CreateRectRgn(0, 0, 0, 0)
  65.  
  66.     PuzzleSize = 5
  67.  
  68.     Menu_Stop.Visible = FALSE
  69.  
  70. End Sub
  71.  
  72. Sub Set_Piece_Priority (Piece As Integer)
  73.  
  74.     Temp = Priority(Piece)
  75.     For I = Piece To 1 Step -1
  76.         Priority(I) = Priority(I - 1)
  77.     Next
  78.     Priority(0) = Temp
  79.  
  80. End Sub
  81.  
  82. Sub Display_A_Piece (destHdc, Piece)
  83.     
  84.     DestX = Pieces(Priority(Piece)).X
  85.     DestY = Pieces(Priority(Piece)).Y
  86.     
  87.     If MaskNeeded Then
  88.         R = BitBlt(Pic_FinalPiece.Hdc, 0, 0, PieceWidth, PieceHeight, Pic_PuzzleImage.Hdc, DestX, DestY, SRCCOPY)
  89.         R = BitBlt(Pic_FinalPiece.Hdc, 0, 0, PieceWidth, PieceHeight, Pic_PieceMask.Hdc, 0, 0, SRCAND)
  90.         R = BitBlt(Pic_FinalPiece.Hdc, 0, 0, PieceWidth, PieceHeight, Pic_PieceImage.Hdc, 0, 0, SRCINVERT)
  91.         R = BitBlt(destHdc, DestX, DestY, PieceWidth, PieceHeight, Pic_FinalPiece.Hdc, 0, 0, SRCCOPY)
  92.     Else
  93.         R = BitBlt(destHdc, DestX, DestY, PieceWidth, PieceHeight, Pic_Bitmap.Hdc, Pieces(Priority(Piece)).HomeX, Pieces(Priority(Piece)).HomeY, SRCCOPY)
  94.     End If
  95.  
  96. End Sub
  97.  
  98.  
  99. Sub Menu_OptionsSelection_Click (Index As Integer)
  100.  
  101.     Pic_Work.MousePointer = 11
  102.  
  103.     Select Case Index
  104.         
  105.         Case MID_SCRAMMBLE
  106.             Scrammble_Puzzle
  107.  
  108.         Case MID_SOLVE
  109.             Solve_Puzzle
  110.  
  111.         Case MID_ANIMATE
  112.             Animate_Puzzle
  113.         
  114.         Case MID_PIECES_TO_FOREGROUND
  115.             Bring_Pieces_To_Foreground
  116.  
  117.         Case MID_SHOW_SCRAMMBLING, MID_SCRAMMBLE_ON_OPEN
  118.             Menu_OptionsSelection(Index).Checked = Not Menu_OptionsSelection(Index).Checked
  119.  
  120.     End Select
  121.  
  122.     Pic_Work.MousePointer = 0
  123.     
  124. End Sub
  125.  
  126. Sub Menu_FileSelection_Click (Index As Integer)
  127.  
  128.     Picture = LoadPicture()
  129.  
  130.     Select Case Index
  131.  
  132.         Case MID_OPEN
  133.             OpenFile.Show MODAL
  134.             If OpenFile.File1.ListIndex >= 0 Then Picture = LoadPicture(OpenFile.File1.FileName)
  135.  
  136.         Case MID_CLIPBOARD
  137.             Picture = ClipBoard.GetData()
  138.  
  139.         Case MID_EXIT
  140.             Unload JigSaw
  141.  
  142.     End Select
  143.  
  144.     If Picture Then
  145.         Menu_Options.Enabled = TRUE
  146.         Menu_Pieces.Enabled = TRUE
  147.         Menu_Hint.Enabled = TRUE
  148.         Pic_Work.Visible = TRUE
  149.         Screen.MousePointer = 11
  150.         Prepare_Bitmap (Menu_OptionsSelection(MID_SCRAMMBLE_ON_OPEN).Checked)
  151.         Screen.MousePointer = 0
  152.         Pic_Window.Refresh
  153.     End If
  154.  
  155. End Sub
  156.  
  157. Sub Prepare_Bitmap (Scrammble)
  158.             
  159.     Pic_Bitmap.Picture = Picture
  160.     Pic_Bitmap.Picture = Pic_Bitmap.Image
  161.  
  162.     PieceWidth = Pic_Bitmap.Width / PuzzleSize
  163.     PieceHeight = Pic_Bitmap.Height / PuzzleSize
  164.  
  165.     Pic_PuzzleImage.Cls
  166.     Pic_PuzzleImage.Move 0, 0, Pic_Bitmap.Width, Pic_Bitmap.Height
  167.     Pic_Work.Move 0, 0, Pic_Bitmap.Width, Pic_Bitmap.Height
  168.     Pic_Mask.Move 0, 0, Pic_Bitmap.Width, Pic_Bitmap.Height
  169.     Pic_Mask.Cls
  170.  
  171.     Form_Resize
  172.     Randomize Timer
  173.     TotalPieces = 24
  174.  
  175.     If MaskNeeded Then
  176.         
  177.         Pic_PieceImage.Move 0, 0, PieceWidth, PieceHeight
  178.         Pic_PieceMask.Move 0, 0, PieceWidth, PieceHeight
  179.         Pic_FinalPiece.Move 0, 0, PieceWidth, PieceHeight
  180.         
  181.         Select Case MaskNeeded
  182.             
  183.             Case MID_CIRCLES_AND_OTHERS
  184.                 Create_Circles_Mask
  185.  
  186.             Case MID_ELIPSES_AND_OTHERS
  187.                 Create_Elipses_Mask
  188.  
  189.             Case MID_ANGELS_AND_STARS
  190.                 Create_Angel_And_Stars_Mask
  191.  
  192.             Case MID_CIRCLES_IN_SQUARES
  193.                 TotalPieces = 31
  194.                 Create_Circles_In_Squares_Mask
  195.  
  196.         End Select
  197.     End If
  198.     
  199.     ReDim Pieces(TotalPieces) As PIECEINFO
  200.     ReDim Priority(TotalPieces) As Integer
  201.  
  202.     If (MaskNeeded > 0) And (MaskNeeded <> MID_CIRCLES_IN_SQUARES) Then
  203.         For Y = 0 To PuzzleSize - 2
  204.             For X = 0 To PuzzleSize - 2
  205.                 I = TotalPieces - (Y * (PuzzleSize - 1) + X)
  206.                 Pieces(I).HomeX = X * PieceWidth + PieceWidth / 2
  207.                 Pieces(I).HomeY = Y * PieceHeight + PieceHeight / 2
  208.                 Pieces(I).X = Pieces(I).HomeX
  209.                 Pieces(I).Y = Pieces(I).HomeY
  210.                 Priority(I) = I
  211.             Next X
  212.         Next Y
  213.     End If
  214.  
  215.     For Y = 0 To PuzzleSize - 1
  216.         For X = 0 To PuzzleSize - 1
  217.             I = (PuzzleSize ^ 2 - 1) - (Y * PuzzleSize + X)
  218.             For Z = 0 To Abs(MaskNeeded = MID_CIRCLES_IN_SQUARES)
  219.                 Pieces(I + Z * 16).HomeX = X * PieceWidth
  220.                 Pieces(I + Z * 16).HomeY = Y * PieceHeight
  221.                 Pieces(I + Z * 16).X = Pieces(I).HomeX
  222.                 Pieces(I + Z * 16).Y = Pieces(I).HomeY
  223.                 Priority(I + Z * 16) = I + Z * 16
  224.             Next Z
  225.         Next X
  226.     Next Y
  227.     
  228.     Select Case MaskNeeded
  229.         Case 0, 4
  230.             Outline_Circles_In_Squares
  231.         Case 1
  232.         Case 2
  233.         Case 3
  234.     End Select
  235.  
  236.     If Scrammble Then
  237.         Scrammble_Puzzle
  238.     Else
  239.         Solved = TRUE
  240.         R = BitBlt(Pic_PuzzleImage.Hdc, 0, 0, Pic_Bitmap.Width, Pic_Bitmap.Height, Pic_Bitmap.Hdc, 0, 0, SRCCOPY)
  241.         Pic_Work.Refresh
  242.     End If
  243.     
  244. End Sub
  245.  
  246. Sub Form_Unload (Cancel As Integer)
  247.  
  248.     End
  249.  
  250. End Sub
  251.  
  252. Sub Form_Resize ()
  253.  
  254.     Pic_Work.Move 0, 0
  255.     
  256.     HScroll1.Move 0, ScaleHeight - HScroll1.Height, ScaleWidth - VScroll1.Width
  257.     VScroll1.Move ScaleWidth - VScroll1.Width, 0, VScroll1.Width, ScaleHeight - HScroll1.Height
  258.     Pic_ScrollBarJoint.Move VScroll1.Left, HScroll1.Top
  259.     Pic_Window.Move 0, 0, VScroll1.Left, HScroll1.Top
  260.  
  261.     HScroll1.Enabled = Pic_Window.Width < Pic_Bitmap.Width
  262.     VScroll1.Enabled = Pic_Window.Height < Pic_Bitmap.Height
  263.     
  264.     If VScroll1.Enabled Then
  265.         VScroll1.Value = 0
  266.         VScroll1.Max = Abs(Pic_Window.Height - Pic_Bitmap.Height)
  267.         VScroll1.LargeChange = VScroll1.Max \ 10
  268.     End If
  269.     
  270.     If HScroll1.Enabled Then
  271.         HScroll1.Value = 0
  272.         HScroll1.Max = Abs(Pic_Window.Width - Pic_Bitmap.Width)
  273.         HScroll1.LargeChange = HScroll1.Max \ 10
  274.     End If
  275.     
  276. End Sub
  277.  
  278. Sub HScroll1_Change ()
  279.   
  280.   ' Pic_Work.Left is set to the Negative of the value since
  281.   ' as you scroll the Scrollbar to the Right, the display
  282.   ' should move to the Left, showing more of the right
  283.   ' of the display, and vice-versa when scrolling to the
  284.   ' left
  285.  
  286.   Pic_Work.Left = -HScroll1.Value
  287.  
  288. End Sub
  289.  
  290. Sub VScroll1_Change ()